Programmer Plus 2007/Programmer-Plus-2007.iso/Programming/Visual Basic 6.0 Utilities/Multi-Language Add-In for Visual Basic 6.0/MultiLang.msi/_AF3F81324EF811D5BEBE0020182C1E5C

Visual Basic Form | 2001-04-24 | 14.9 KB | 449 lines

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmMain
   Caption         =   "SimpleEditor"
   ClientHeight    =   2484
   ClientLeft      =   132
   ClientTop       =   708
   ClientWidth     =   3744
   LinkTopic       =   "Form1"
   ScaleHeight     =   2484
   ScaleWidth      =   3744
   StartUpPosition =   3  'Windows Default
   Begin VB.TextBox Text1
      BeginProperty Font
         Name            =   "Courier New"
         Size            =   10.2
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1452
      Left            =   1200
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   2
      Top             =   480
      Width           =   2412
   End
   Begin MSComctlLib.Toolbar tbToolBar
      Align           =   1  'Align Top
      Height          =   336
      Left            =   0
      TabIndex        =   1
      Top             =   0
      Width           =   3744
      _ExtentX        =   6604
      _ExtentY        =   593
      ButtonWidth     =   487
      Appearance      =   1
      ImageList       =   "imlToolbarIcons"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}
         NumButtons      =   7
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}
            Key             =   "New"
            Object.ToolTipText     =   "New"
            ImageKey        =   "New"
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}
            Key             =   "Open"
            Object.ToolTipText     =   "Open"
            ImageKey        =   "Open"
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}
            Key             =   "Save"
            Object.ToolTipText     =   "Save"
            ImageKey        =   "Save"
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}
            Style           =   3
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}
            Key             =   "Cut"
            Object.ToolTipText     =   "Cut"
            ImageKey        =   "Cut"
         EndProperty
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}
            Key             =   "Copy"
            Object.ToolTipText     =   "Copy"
            ImageKey        =   "Copy"
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}
            Key             =   "Paste"
            Object.ToolTipText     =   "Paste"
            ImageKey        =   "Paste"
         EndProperty
      EndProperty
   End
   Begin MSComDlg.CommonDialog dlgCommonDialog
      Left            =   120
      Top             =   360
      _ExtentX        =   677
      _ExtentY        =   677
      _Version        =   393216
   End
   Begin MSComctlLib.StatusBar sbStatusBar
      Align           =   2  'Align Bottom
      Height          =   264
      Left            =   0
      TabIndex        =   0
      Top             =   2220
      Width           =   3744
      _ExtentX        =   6604
      _ExtentY        =   466
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
         NumPanels       =   3
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
            AutoSize        =   1
            Text            =   "Status"
            TextSave        =   "Status"
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
            Style           =   6
            AutoSize        =   2
            TextSave        =   "23.04.01"
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
            Style           =   5
            AutoSize        =   2
            TextSave        =   "22:43"
         EndProperty
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   7.8
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin MSComctlLib.ImageList imlToolbarIcons
      Left            =   600
      Top             =   360
      _ExtentX        =   804
      _ExtentY        =   804
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
         NumListImages   =   6
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "frmMain.frx":0000
            Key             =   "New"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "frmMain.frx":0112
            Key             =   "Open"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "frmMain.frx":0224
            Key             =   "Save"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "frmMain.frx":0336
            Key             =   "Cut"
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "frmMain.frx":0448
            Key             =   "Copy"
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "frmMain.frx":055A
            Key             =   "Paste"
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileNew
         Caption         =   "&New"
         Shortcut        =   ^N
      End
      Begin VB.Menu mnuFileOpen
         Caption         =   "&Open..."
      End
      Begin VB.Menu mnuFileClose
         Caption         =   "&Close"
      End
      Begin VB.Menu mnuFileBar0
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileSave
         Caption         =   "&Save"
      End
      Begin VB.Menu mnuFileSaveAs
         Caption         =   "Save &As..."
      End
      Begin VB.Menu mnuFileBar1
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuEdit
      Caption         =   "&Edit"
      Begin VB.Menu mnuEditCut
         Caption         =   "Cu&t"
         Shortcut        =   ^X
      End
      Begin VB.Menu mnuEditCopy
         Caption         =   "&Copy"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuEditPaste
         Caption         =   "&Paste"
         Shortcut        =   ^V
      End
   End
   Begin VB.Menu mnuView
      Caption         =   "&View"
      Begin VB.Menu mnuViewToolbar
         Caption         =   "&Toolbar"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuViewStatusBar
         Caption         =   "Status &Bar"
         Checked         =   -1  'True
      End
   End
   Begin VB.Menu mnuTools
      Caption         =   "&Tools"
   End
   Begin VB.Menu mnuHelp
      Caption         =   "&Help"
      Begin VB.Menu mnuHelpAbout
         Caption         =   "&About "
      End
   End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'-------------------------------------------------------------------------------
'API declarations
'-------------------------------------------------------------------------------
Private Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Type POINTAPI
        x As Long
        y As Long
End Type
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Type WINDOWPLACEMENT
        Length As Long
        flags As Long
        showCmd As Long
        ptMinPosition As POINTAPI
        ptMaxPosition As POINTAPI
        rcNormalPosition As RECT
End Type
Private Declare Function GetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
Private Declare Function SetWindowPlacement Lib "user32" (ByVal hwnd As Long, lpwndpl As WINDOWPLACEMENT) As Long
'-------------------------------------------------------------------------------
'End of API declarations
'-------------------------------------------------------------------------------
Private fso As New FileSystemObject
Private sFile As String
Private bDirty As Boolean
Private Sub Form_Load()
  'If you want to copy anything from this program, this is the most useful feature.
  'Using GetWindowPlacement and SetWindowPlacement enable you so save the normal
  'position of the window correctly, even if the window is maximised.
  Dim wp As WINDOWPLACEMENT
  GetWindowPlacement hwnd, wp
  wp.rcNormalPosition.Top = GetSetting(App.Title, "Settings", "MainTop", 100)
  wp.rcNormalPosition.Left = GetSetting(App.Title, "Settings", "MainLeft", 100)
  wp.rcNormalPosition.Bottom = GetSetting(App.Title, "Settings", "MainBottom", 500)
  wp.rcNormalPosition.Right = GetSetting(App.Title, "Settings", "MainRight", 500)
  wp.showCmd = GetSetting(App.Title, "Settings", "MainState", SW_SHOWNORMAL)
  SetWindowPlacement hwnd, wp
  'Extra resize, because SetWindowPlacement causes the toolbar to be too high.
  'You can't win 'em all!
  DoEvents
  Form_Resize
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  'Save file if dirty flag is set
  Dim Response As VbMsgBoxResult
  Response = PromptIfDirty
  If Response = vbCancel Then
    Cancel = 1
  End If
End Sub
Private Sub Form_Resize()
  Dim ClientTop As Long
  Dim ClientHeight As Long
  If mnuViewToolbar.Checked Then
    ClientTop = tbToolBar.Height
  Else
    ClientTop = 0
  End If
  If mnuViewStatusBar.Checked Then
    ClientHeight = Me.ScaleHeight - ClientTop - sbStatusBar.Height
  Else
    ClientHeight = Me.ScaleHeight - ClientTop
  End If
  Text1.Move 0, ClientTop, Me.ScaleWidth, ClientHeight
End Sub
Private Sub Form_Unload(Cancel As Integer)
  Dim i As Integer
  'close all sub forms
  For i = Forms.Count - 1 To 1 Step -1
    Unload Forms(i)
  Next
  'Window position.
  'GetWindowPlacement() get the normal position when the window is maximised.
  Dim wp As WINDOWPLACEMENT
  GetWindowPlacement hwnd, wp
  If wp.showCmd = SW_SHOWMINIMIZED Then
    wp.showCmd = SW_SHOWNORMAL
  End If
  SaveSetting App.Title, "Settings", "MainLeft", wp.rcNormalPosition.Left
  SaveSetting App.Title, "Settings", "MainTop", wp.rcNormalPosition.Top
  SaveSetting App.Title, "Settings", "MainRight", wp.rcNormalPosition.Right
  SaveSetting App.Title, "Settings", "MainBottom", wp.rcNormalPosition.Bottom
  SaveSetting App.Title, "Settings", "MainState", wp.showCmd
End Sub
Private Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)
  On Error Resume Next
  Select Case Button.Key
    Case "New"
      mnuFileNew_Click
    Case "Open"
      mnuFileOpen_Click
    Case "Save"
      mnuFileSave_Click
    Case "Cut"
      mnuEditCut_Click
    Case "Copy"
      mnuEditCopy_Click
    Case "Paste"
      mnuEditPaste_Click
  End Select
End Sub
Private Sub mnuHelpAbout_Click()
  frmAbout.Show vbModal, Me
End Sub
Private Sub mnuViewStatusBar_Click()
  mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
  sbStatusBar.Visible = mnuViewStatusBar.Checked
  Form_Resize
End Sub
Private Sub mnuViewToolbar_Click()
  mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
  tbToolBar.Visible = mnuViewToolbar.Checked
  Form_Resize
End Sub
Private Sub mnuEditPaste_Click()
  Text1.SelText = Clipboard.GetText()
End Sub
Private Sub mnuEditCopy_Click()
  Clipboard.Clear
  Clipboard.SetText Text1.SelText
End Sub
Private Sub mnuEditCut_Click()
  Clipboard.Clear
  Clipboard.SetText Text1.SelText
  Text1.SelText = ""
End Sub
Private Sub mnuFileExit_Click()
  'unload the form
  Unload Me
End Sub
Private Sub mnuFileSaveAs_Click()
  With dlgCommonDialog
    .DialogTitle = "Save"
    .CancelError = False
    .Filter = "All Files (*.*)|*.*|Text Files (*.txt)|*.txt"
    .FilterIndex = 2
    .ShowSave
    If Len(.FileName) = 0 Then
      Exit Sub
    End If
    sFile = .FileName
  End With
  Dim txt As TextStream
  Set txt = fso.CreateTextFile(sFile)
  txt.Write Text1.Text
End Sub
Private Sub mnuFileSave_Click()
  If sFile = "" Then
    mnuFileSaveAs_Click
  Else
    Dim txt As TextStream
    Set txt = fso.CreateTextFile(sFile)
    txt.Write Text1.Text
  End If
End Sub
Private Sub mnuFileClose_Click()
  'Its a stupid menu item. Close and New are identical!
  mnuFileNew_Click
End Sub
Private Sub mnuFileOpen_Click()
  With dlgCommonDialog
    .DialogTitle = "Open"
    .CancelError = False
    .Filter = "All Files (*.*)|*.*|Text Files (*.txt)|*.txt"
    .FilterIndex = 2
    .ShowOpen
    If Len(.FileName) = 0 Then
      Exit Sub
    End If
    sFile = .FileName
  End With
  'Put the file name in the title bar
  Me.Caption = App.Title & " - " & sFile
  'Read the file
  Dim txt As TextStream
  Set txt = fso.OpenTextFile(sFile)
  Text1.Text = txt.ReadAll
  'Clear the dirty flag
  bDirty = False
End Sub
Private Sub mnuFileNew_Click()
  Dim Response As VbMsgBoxResult
  'Save file if dirty flag is set
  Response = PromptIfDirty
  If Response <> vbCancel Then
    'Clear the text
    Text1.Text = ""
    'Clear the dirty flag
    bDirty = False
  End If
End Sub
Private Sub Text1_Change()
  bDirty = True
End Sub
Private Function PromptIfDirty() As VbMsgBoxResult
  Dim Response As VbMsgBoxResult
  If bDirty Then
    Response = MsgBox("Save changes?", vbYesNoCancel, "SimpleEditor")
    If Response = vbYes Then
      mnuFileSave_Click
      bDirty = False
    End If
  Else
    Response = vbOK
  End If
  PromptIfDirty = Response
End Function